home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb40.zip / PROLDR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-05-20  |  3KB  |  109 lines
  1. Program ProLdr;  { Loads a font file into the RAM area of IBM Proprinter. }
  2. Const
  3.   MaxChar = 94;
  4.   MinChar = 1;
  5. Type
  6.   Fontype = array[0..11] of integer;
  7.   Filetype = file of fontype;
  8.   Str255   = String[255];
  9.   Str80    = String[80];
  10.   Str4     = array[1..4] of char;
  11.  
  12. Var
  13.   Font     :  array[1..MaxChar] of Fontype;
  14.   Fontfile :  Filetype;
  15.   ColNum   :  Integer;
  16.   Error    :  Str80;
  17.   Ans      :  Integer;
  18.   Extension  :  Str4;
  19.   Count1,Count2  :  integer;
  20.   c1,c2,CopyNum,PrtNum : integer;
  21.   CharNum :  integer;
  22.   MaxCopy : integer;
  23.   Attribute : integer;
  24.  
  25. {$I Beep.inc }
  26. {$I Answer.inc }
  27. {$I Files.inc }
  28. {$I DirExt.inc }
  29.  
  30. Begin
  31.   Error := 'O';
  32.   Extension[1] := '.';
  33.   Extension[2] := 'F';
  34.   Extension[3] := 'N';
  35.   Extension[4] := 'T';
  36.   writeln('EPSON font file loader.         by C.A. Rinehart (c) 1986');
  37.   writeln('   Present font file names are: ');
  38.   ListDirectory;
  39.   writeln;
  40.   writeln('Copy characters from disk font file to printer.');
  41.   repeat
  42.     Error := 'O';
  43.     OpenFile(FontFile,Error,Extension);
  44.     If Error <> '' then
  45.       begin
  46.         writeln(Error);
  47.         write('Try another file? (Y/N)  ');
  48.         Answer('yes,no',Ans,false);
  49.         writeln;
  50.         end;
  51.    until (Ans = 2) or (Error = '');
  52.    CharNum := MinChar;
  53.    if Error = '' then
  54.      begin
  55.        repeat
  56.          write('Enter first character # to be copied.  ');
  57.          readln(c1);
  58.          write('Enter last character # to be copied.  ');
  59.          readln(c2);
  60.          write('Enter first character # to which the characters will be copied.  ');
  61.          readln(PrtNum);
  62.        until (c2 >= c1) and (PrtNum in [MinChar..MaxChar]) and (c2 in [MinChar..MaxChar]);
  63.        seek(FontFile,c1);
  64.        CopyNum := c2-c1;
  65.        MaxCopy := CopyNum;
  66.        Count1 := CopyNum * 13 + 2;
  67.        Count2 := 0;
  68.        if CopyNum = MaxChar then
  69.          begin
  70.            Count1 := 200;
  71.            Count2 := 4;
  72.          end;
  73.        while  (NOT EOF(FontFile)) and (CharNum <= MaxChar) and (CopyNum >= 0) do
  74.          begin
  75.            read(fontfile, font[CharNum]);
  76.            CharNum := CharNum + 1;
  77.            CopyNum := CopyNum - 1;
  78.          end;
  79.        end
  80.      else
  81.        begin
  82.          writeln;
  83.          writeln('No characters read from file!');
  84.          beep(1);
  85.          delay(2000);
  86.        end;
  87.      CloseFile(FontFile, Error);
  88.      if Error <> '' then
  89.        begin
  90.          writeln('Close file error:');
  91.          writeln(Error);
  92.          beep(1);
  93.          delay(2000);
  94.        end;
  95.    write(Lst,chr(27),'=',chr(count1),chr(count2),chr(20),chr(PrtNum));
  96.      for CharNum := 1 to MaxCopy do
  97.        begin
  98.          if font[charnum,0] >= 128 then
  99.           attribute := 1
  100.          else
  101.           attribute := 0;
  102.          write(Lst,chr(attribute), chr(0));
  103.          for ColNum := 1 to 11 do
  104.            write(Lst,chr(font[CharNum,ColNum]));
  105.        end;
  106. end.
  107.  
  108.  
  109.